;;; -*- Mode: Lisp; Package: File-System; Base: 10.; Readtable: T -*-

;; This file contains the access interface to the local file system.

(DEFFLAVOR LOCAL-FILE-ACCESS () (DIRECTORY-LIST-MIXIN BASIC-ACCESS))

(DEFINE-FILE-ACCESS LOCAL-FILE-ACCESS .95S0 (:LOCAL))

(DEFMETHOD (LOCAL-FILE-ACCESS :RESET) () (SEND SELF :CLOSE-ALL-FILES))

(DEFMETHOD (LOCAL-FILE-ACCESS :OPEN-STREAMS) ()
  LM-FILE-STREAMS-LIST)

(DEFMETHOD (LOCAL-FILE-ACCESS :ACCESS-DESCRIPTION) ()
  "Direct access to the file system on this disk.")

(DEFMETHOD (LOCAL-FILE-ACCESS :CLOSE-ALL-FILES) ()
  (DOLIST (S LM-FILE-STREAMS-LIST)
    (CLOSE S)))

(DEFMETHOD (LOCAL-FILE-ACCESS :HOMEDIR) (&OPTIONAL (USER USER-ID))
  (FERROR NIL "Should not get here."))

(DEFMETHOD (LOCAL-FILE-ACCESS :CHANGE-PROPERTIES) (PATHNAME ERROR-P &REST PLIST)
  (IDENTIFY-FILE-OPERATION :CHANGE-PROPERTIES
    (HANDLING-ERRORS ERROR-P
      (OPEN-INPUT-FILE (FILE PATHNAME)
        (LMFS-CHANGE-FILE-PROPERTIES FILE PLIST)))))

(DEFMETHOD (LOCAL-FILE-ACCESS :PROPERTIES) (PATHNAME &OPTIONAL ERROR-P)
  (IDENTIFY-FILE-OPERATION :PROPERTIES
    (HANDLING-ERRORS ERROR-P
      (OPEN-INPUT-FILE (F PATHNAME)
        (VALUES (CONS (FILE-TRUENAME F) (LMFS-FILE-PROPERTIES F))
                LM-UNSETTABLE-PROPERTIES)))))

(DEFMETHOD (LOCAL-FILE-ACCESS :COMPLETE-STRING) (PATHNAME STRING OPTIONS)
  (MULTIPLE-VALUE-BIND (DEV DIR NAM TYP VER)
      (SEND PATHNAME :PARSE-NAMESTRING HOST STRING)
    (MULTIPLE-VALUE-BIND (NEW-DIRECTORY NEW-NAME NEW-TYPE COMPLETION)
        (LMFS-COMPLETE-PATH (OR DIR (PATHNAME-DIRECTORY PATHNAME) "")
                            (OR NAM "") (OR TYP "")
                            NAME TYPE OPTIONS)
      (VALUES (LM-NAMESTRING HOST (OR DEV DEVICE) NEW-DIRECTORY NEW-NAME NEW-TYPE VER)
              COMPLETION))))

(DEFMETHOD (LOCAL-FILE-ACCESS :CREATE-DIRECTORY) (PATHNAME &OPTIONAL (ERROR T))
  (IDENTIFY-FILE-OPERATION :CREATE-DIRECTORY
    (HANDLING-ERRORS ERROR
      (LMFS-CREATE-DIRECTORY (PATHNAME-DIRECTORY PATHNAME))
      T)))

(DEFMETHOD (LOCAL-FILE-ACCESS :CREATE-LINK) (PATHNAME TARGET (ERROR T))
  TARGET
  (HANDLING-ERRORS ERROR
    (LM-SIGNAL-ERROR 'LINKS-NOT-SUPPORTED NIL NIL :CREATE-LINK)))

(DEFMETHOD (LOCAL-FILE-ACCESS :REMOTE-CONNECT) (&REST IGNORE)
  TARGET
  (HANDLING-ERRORS ERROR
    (LM-SIGNAL-ERROR 'REMOTE-CONNECT-NOT-SUPPORTED NIL NIL :CREATE-LINK)))

(DEFMETHOD (LOCAL-FILE-ACCESS :OPEN) (FILE PATHNAME &REST OPTIONS)
  (APPLY 'LMFS-OPEN-FILE PATHNAME
         (PATHNAME-RAW-DIRECTORY PATHNAME)
         (PATHNAME-RAW-NAME PATHNAME)
         (PATHNAME-RAW-TYPE PATHNAME)
         (PATHNAME-RAW-VERSION PATHNAME)
         OPTIONS))

(DEFMETHOD (LOCAL-FILE-ACCESS :DIRECTORY-LIST) (PATHNAME OPTIONS)
  (LMFS-DIRECTORY-LIST SELF HOST
         (PATHNAME-RAW-DIRECTORY PATHNAME)
         (PATHNAME-RAW-NAME PATHNAME)
         (PATHNAME-RAW-TYPE PATHNAME)
         (PATHNAME-RAW-VERSION PATHNAME)
         OPTIONS))

(DEFMETHOD (LOCAL-FILE-ACCESS :RENAME) (PATHNAME NEW-NAME &OPTIONAL (ERROR-P T))
  (IDENTIFY-FILE-OPERATION :RENAME
    (HANDLING-ERRORS ERROR-P
      (OPEN-INPUT-FILE (FILE PATHNAME)
        (LMFS-RENAME-FILE FILE
                          (PATHNAME-DIRECTORY NEW-NAME)
                          (OR (PATHNAME-NAME NEW-NAME) "FOO")
                          (OR (PATHNAME-TYPE NEW-NAME) :UNSPECIFIC)
                          (PATHNAME-VERSION NEW-NAME))))))

(DEFMETHOD (LOCAL-FILE-ACCESS :DELETE) (PATHNAME &OPTIONAL (ERROR-P T))
  (IDENTIFY-FILE-OPERATION :DELETE
    (HANDLING-ERRORS ERROR-P
      (OPEN-INPUT-FILE (FILE PATHNAME)
        (LMFS-DELETE-FILE FILE)))))

(DEFMETHOD (LOCAL-FILE-ACCESS :UNDELETE) (PATHNAME &OPTIONAL (ERROR-P T))
  (IDENTIFY-FILE-OPERATION :UNDELETE
    (HANDLING-ERRORS ERROR-P
      (OPEN-INPUT-FILE (FILE PATHNAME)
        (LMFS-UNDELETE-FILE FILE)))))

(DEFMETHOD (LOCAL-FILE-ACCESS :EXPUNGE) (PATHNAME &OPTIONAL (ERROR T))
  (IDENTIFY-FILE-OPERATION :EXPUNGE
    (HANDLING-ERRORS ERROR
      (LMFS-EXPUNGE-DIRECTORY
        (PATHNAME-RAW-DIRECTORY PATHNAME)
        (PATHNAME-RAW-NAME PATHNAME)
        (PATHNAME-RAW-TYPE PATHNAME)
        (PATHNAME-RAW-VERSION PATHNAME)))))

;;;???
(DEFMETHOD (LOCAL-FILE-ACCESS :DELETE-MULTIPLE-FILES) (ERROR-P PATHNAMES)
  (IDENTIFY-FILE-OPERATION :DELETE
    (HANDLING-ERRORS ERROR-P
       (LOOP FOR PATHNAME IN PATHNAMES
             WITH FILES-OF-DIRECTORY-TO-WRITE = NIL
             DO (OPEN-INPUT-FILE (FILE PATHNAME)
                   (LMFS-DELETE-FILE FILE NIL)
                   (LOOP FOR ENTRY IN FILES-OF-DIRECTORY-TO-WRITE
                         WHEN (EQUAL (FILE-DIRECTORY FILE) (FILE-DIRECTORY ENTRY))
                         RETURN NIL
                         FINALLY (PUSH FILE FILES-OF-DIRECTORY-TO-WRITE)))
             FINALLY
             (DOLIST (FILE FILES-OF-DIRECTORY-TO-WRITE)
               (WRITE-DIRECTORY-OF-FILE FILE))))))

(DEFMETHOD (LOCAL-FILE-ACCESS :ALL-DIRECTORIES) (OPTIONS)
  (LMFS-ALL-DIRECTORIES HOST (NOT (MEMQ :NOERROR OPTIONS))))

(DEFMETHOD (LOCAL-FILE-ACCESS :MULTIPLE-FILE-PLISTS) (PATHNAMES OPTIONS)
  "This is a hack to speed up DIRED.
There are no currently meaningful options." OPTIONS
  (IDENTIFY-FILE-OPERATION :PROPERTIES
    (MAPCAR #'(LAMBDA (PATHNAME)
                (LET ((TPATHNAME (SEND PATHNAME :TRANSLATED-PATHNAME)))
                  (OPEN-INPUT-FILE (FILE TPATHNAME)
                    (IF (NULL FILE)
                        (LIST PATHNAME)
                      (LIST* PATHNAME
                             :TRUENAME (FILE-TRUENAME FILE)
                             (LMFS-FILE-PROPERTIES FILE))))))
            PATHNAMES)))

(COMPILE-FLAVOR-METHODS LOCAL-FILE-ACCESS)
